EXHIBIT F 
View Menu 



Private Sub Form_Initialize { ) 
Dim Itemlndex As Integer 
Dim i As Integer 
Dim Item As Listlraage 
Dim V As Variant 
Dim c As Collection 
Dim strTemp As String 
Dim LoadParentEntity As Boolean 
Dim LoadAdHocEntity As Boolean 
Dim LoadReportEntity As Boolean 
Dim LoadReferenceTable As Boolean 

On Error GoTo ErrForm_Initialize 

LoadParentEntity - (ParentCount > 0) 
LoadReportEntity = (ReportCount > 0) 
LoadReferenceTable = (ReferenceTableCount > 0) 
LoadAdHocEntity = (ReportEntityCount > 0) 

If LoadParentEntity Then 
Set c = GetEntitylcons ( ) 
If Not c Is Nothing Then 
i = 1 

For Each v In c 

StrTemp = "KEY_" & v.EntitylD 

Set Item = imgLargelcons.Listlmages .Add (i, strTemp, LoadPicture (App. Path & "\" & gData. IconPath & "\" & 
V. IconFileName) ) 

Item. Tag = v.EntityCaption 
i = i + 1 
Next V 

Set c = Nothing 
End If 
End If 

Me. Caption = gData. Caption 

Me. Icon = LoadPicture (gData. Applicationlcon) 
Call SetAppIcon(Me) 

Set Frame. ImageListControl = imgLargelcons 
Itemlndex = 0 
m_FormLoaded - False 

For i = 1 To imgLargelcons. Listlmages .Count 
Set Item = imgLargelcons.Listlmages (i ) 
If (Item. Key = "REFERENCE_TABLE" ) Then 
If LoadReferenceTable Then 

Frame. Addltem Item. Key, Item. Tag, Item. Index, "pnlMaintenance" 
If Itemlndex > 0 Then 

Load mnuViewI terns ( Itemlndex ) 
mnuViewItems( Itemlndex) .Caption = 
Itemlndex = Itemlndex + 1 
Load mnuViewI terns ( Itemlndex ) 
End If 

mnuViewItems (Itemlndex) .Caption - & Item. Tag 
mnuViewItems{ Itemlndex) .Tag = Item. Key 
Itemlndex = Itemlndex + 1 
End If 

Elself (Item. Key = "QUERY") Then 
If LoadAdHocEntity Then 

Frame. Addltem Item. Key, Item. Tag, Item. Index, "pnlEntityReports" 

If Itemlndex > 0 Then 

Load mnuViewItems ( Itemlndex ) 

mnuViewItems (Itemlndex) .Caption = 

Itemlndex = Itemlndex + 1 

Load mnuViewItems ( Itemlndex) 
End If 

mnuViewItems (Itemlndex) . Caption = "&" & Item. Tag 

mnuViewItems (Itemlndex) .Tag = Item. Key 
Itemlndex = Itemlndex + 1 

End If 

Elself (Item. Key = "REPORT") Then 
If LoadReportEntity Then 

Frame. Addltem Item. Key, Item. Tag, Item. Index, "pnlReportTool" 
If Itemlndex > 0 Then 

Load mnuViewItems ( Itemlndex) 
mnuViewItems (Itemlndex) .Caption = "-" 
Itemlndex = Itemlndex + 1 
Load mnuViewItems ( Itemlndex ) 
End If 
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mnuViewItems ( Itemlndex ). Caption = "&" & Item. Tag 
mnuViewItems { Itemlndex ) . Tag = Item. Key 
Itemlndex = Itemlndex + 1 
End If 
Else 

If LoadParentEntity Then 

Frame. Addltem Right$ (Item. Key, Len (Item. Key) - 4), Item. Tag, Item. Index, "pnlEntityView" 
If Itemlndex > 0 Then 

Load mnuViewItems (Itemlndex) 
End If 

mnuViewItems (Itemlndex) .Caption = & Item. Index & & Item. Tag 

mnuViewItems (Itemlndex) .Tag = Right { Item. Key, Len (Item. Key) - 4) 
Itemlndex = Itemlndex + 1 
End If 
End If 
Next i 

If LoadAdHocEntity Then 

pnlEntityReports . SetAppInformationObj ect gData . Applicationlnfo 

pnlEntityReports . InitObj ect 
End If 

If LoadReportEntity Then 

pnlReportTool . SetAppInformationObj ect gData. Applicationlnfo 

pnlReportTool . InitObj ect 
End If 

Set Operation = New clsOperation 
LoadTools 
Exit Sub 
ErrForm_Initialize: 
HandleError Err 

End Sub 
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Parent Entities 



Public Sub Refresh!) 

If m_CurrentEntityID = m_EntityID Then 

grdResults . Refresh 
Elself Filter = Then 

m_CurrentEntityID = m_EntityID 

LoadEntityParameters 

txtCriteria.Text 

grdResults . EntitylD = m_EntityID 
grdResults, LoadStructureOnly = True 
grdResults. CustomSQL = False 
grdResults. Filter = 
grdResults - Refresh 
Else 

m_CurrentEntityID = m_EntityID 
LoadEntityParameters 
txtCriteria.Text = 
grdResults -EntitylD = m_EntityID 
grdResults. LoadStructureOnly = False 
grdResults. CustomSQL False 
grdResults. Filter = Filter 
grdResults . Refresh 
End If 

SetCurrentID 

On Error Resume Next 
txtCriteria . SetFocus 
Err. Clear 
End Sub 

Private Sub SetCurrentID ( ) 
Static V As Variant 

LockWindow UserControl . Parent. hwnd. True 
If grdResults . RecordCount = 0 Then 

V = -1 
Else 

V - grdResults. RowID 
End If 

EntityRelations.ShowAllChildren = True 
EntityRelations . ParentRowID = v 
EntityRelations. ParentEntitylD = m_EntityID 
V = EntityRelations. ChildRowID 
EntityRelations . Refresh 
EntityRelations. ChildRowID = v 
On Error Resume Next 
grdResults . SetFocus 
Err-Clear 

LockWindow Us erCont ro 1 . Parent. hwnd. False 
End Sub 

( From UserlnterfaceX Interfaces Source\GenericControls\ListBoxControl . ctl ) 
Public Sub Refresh () 

Dim V As Variant 

Dim CR As COMMAND__T 

Dim i As Long 

m_LoadingControl = True 

AllowDataEntry = False 

LockWindow CurrentGrid ( ) .hwnd. True 

If m_ParentEntityID = -1 Then 
m_RelationID = -1 

If GetAppInfo(m_EntityID, "ENTITY", "REFERENCE") Then 

m_Context = "REFERENCE" 
Else 

m_Context = "ENTITY" 
End If 
Else 

m_RelationID = gOata . Applicationlnfo . GetRelationshipInf o (m_ParentEntityID, m_EntityID, "RELATION_ID" ) 
m_Context = gData.Applicationlnfo.GetRelationshipInfo (m_ParentEntityID, m_EntityID, "RELATION_TYPE" ) 
End If 

If m_ObjectID = -1 Then m_ObjectID = MessageHandler.GetNextObjectID( ) 
If m_RelationID = -1 Then 

V = GetAppInfo(m_EntityID, "ENTITY_ATTRIBUTE", "ALLOW_GROUP_BY" ) 
Else 

V = GetAppInfo(m_RelationID, "RELATIONSHIP_ATTRIBUTE", "ALLOW_GROUP_BY" ) 
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End If 

If IsNull(v) Then v = 0 

CurrentGrid( ) .GroupByBoxVisible = CBool(v) 

Set m_SearchColumns = Nothing 
Select Case m_Context 
Case "ENTITY" 

Set m_SearchColumns = GetSearchColumns (m_EntityID, False) 
Case "REFERENCE" 
Case Else 

Set ra_SearchColumns = GetSearchColumns (in_RelationID, True) 
End Select 

m_KeyField = GetAppInfo (m_EntityID, "ENTITY", "UNIQUE_FIELD_NAME" ) 
m_ShowKeyField = GetAppInf o (m_EntityID, "ENTITY", "SHOW_UNIQUE_FIELD" ) 
Select Case m_Context 
Case "MANY_TO_MANY" 

m_MapsToKeyField = GetAppInf o IgData . ApplicationInfo.GetMapsToEntityID(rn_ParentEntityID, m_EntltyID) , 
"ENTITY", "UNIQUE_FIELD_NAME") 
Case Else 

m_MapsToKeyField = "** 
End Select 

Select Case m_Context 

Case "ENTITY", "REFERENCE" 

m_FilterField = m_KeyField 

m_ShowFilterField = m_ShowKey Field 
Case Else 

m_FilterField = GetAppInfo {m_ParentEntityID, "ENTITY", "UNIQUE_FIELD__NAME" ) & 
m_ShowFi Iter Field - False 
End Select 

LockWindow CurrentGrid ( ) .hwnd. False 
LoadGrld 

LockWindow CurrentGrid () .hwnd. True 

If Not CurrentGrid( ) .Visible Then CurrentGrid () .Visible = True 

m__RowID = -1 

SetCurrentRow 

EnableMenus 

in_SortColumn = 

LockWindow CurrentGrid (). hwnd. False 
m_LoadingControl = False 
End Sub 
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Quick-Text Search 



Private Sub RunQuery() 

Dim SelectClause As String 
Dim OrderByClause As String 
Dim RecordSource As String 

LockWindow UserControl . Parent « hwnd. True 

RecordSource = GetAppInfo (m_EntityID, "ENTITY", "RECORD_SOURCE" ) 
OrderByClause = gData . Applicationlnfo.GetEntityOrderBy (m_EntityID) 
If OrderByClause <> "" Then 

OrderByClause = "Order By " & OrderByClause 
End If 

grdResults. Filter = 

grdResults.LoadStructureOnly = False 
grdResults. CustomSQL = True 

m_SelectAllSymbol = GetAppInfo ("SELECT_ALL_SYMBOL'% "SYSTEM_INFO", "ATTRIBUTE__VALUE" ) 
SelectClause = "Select " & RecordSource & ".* From & RecordSource & " " 
If Trim$ (txtCriteria.Text) = m_SelectAll Symbol Then 

grdResults. SQL - SelectClause & OrderByClause 
Else 

grdResults. SQL = SearchEntity (m_EntityID, txtCriteria.Text) 
End If 

LockWindow UserControl . Parent . hvmd. False 
grdResults . Refresh 
RecordCountMessage 
On Error Resume Next 
txtCriteria . SetFocus 
Err, Clear 
End Sub 

Public Function SearchEntity (EntitylD As Long, SearchValue As String) As String 
Dim EntityChildren As Collection 
Dim SearchColumns As Collection 
Dim SelectClause As String 
Dim WhereClause As String 
Dim PrimarySelectClause As String 
Dim PrimaryWhereClause As String 
Dim Prima ryOrderByClause As String 
Dim PrimaryKeyField As String 
Dim PrimaryTable As String 
Dim KeyField As String 
Dim TempWhereClause As String 
Dim ERDO As ENTITY_RELATION_T 
Dim ER As ENTITY_RELATION_T 
Dim EC As ENTITy_COLUMN_T 
Dim rs As ADODB. Recordset 
Dim fDef As ADODB. Field 
Dim i As Long 
Dim j As Long 

Dim IgnoreColumn As Boolean 

Dim AllowSearch As Boolean 

Dim SearchType As String 

Dim V As Variant 

Dim Names ( ) As String 

Dim s As String 

Dim SQL As String 

Dim DatasourcelD As Long 

Dim PlatformID As Long 

Dim RightFieldDelimiter As String 

Dim LeftFieldDelimiter As String 

DatasourcelD = GetAppInfo {EntitylD, "ENTITY", "DATASOURCE_ID" ) 
PlatformID = GetAppInfo (DatasourcelD, "DATASOURCE", "PLATFORM_ID" ) 

Select Case GetAppInfo (PlatformID, " PLAT FORM_ATTRI BUTE", "FIELD_DELIMITER" ) 

Case "BRACKET" 

LeftFieldDelimiter = "[" 

RightFieldDelimiter = "]" 
Case "DOUBLE_QUOTE" 

LeftFieldDelimiter « Chr(34) 

RightFieldDelimiter = Chr(34) 
End Select 

Set EntityChildren = gData . Applicationlnfo .GetEntityChildren (EntitylD) 

ERD = gData. Applicationlnfo. GetERD( ) 
For i 1 To UBound(ERD) 
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ER = ERD(i) 
WhereClause = 

KeyField = GetAppInfo(ER.EntityID, "ENTITY", "UNIQUE_FIELD_NAME" ) & "" 
If ER.EntitylD = EntitylD Then 

Prima ryKeyFi eld = KeyField 

PrimaryTable = ER.TableName 

s = GetAppInfo( ER.EntitylD, "ENTITY", "RECORD^SOURCE" ) 

PrimarySelectClause = "SELECT " is; s & FROM " & GetTablePref ix (DatasourcelD) & s & " " 

PrimaryOrderByClause = gData.Applicationlnfo.GetEntityOrderBy (ER.EntitylD) 
If PrimaryOrderByClause <> "" Then 

PrimaryOrderByClause = "ORDER BY " & PrimaryOrderByClause 
End If 

SelectClause = PrimarySelectClause 
Else 

SelectClause ^ "SELECT " & KeyField & " FRCa^ " & GetTablePref ix { DatasourcelD) & GetAppInfo (ER.EntitylD, 
"ENTITY", "RECORD_SOURCE") & " " 
End If 

If EntitylD = ER.EntitylD Then 

AllowSearch - True 
Else 

On Error Resume Next 

V = EntityChildren("ENTITY_" & ER.EntitylD) 
If Err. Number = 0 Then 

AllowSearch = True 
Else 

AllowSearch = False 
Err. Clear 
End If 
End If 

If Not AllowSearch Then 

ER.Tag = "" 
Else 

Set rs « GetEmptyRS (ER.EntitylD, False) 
If rs Is Nothing Then 

WhereClause = "WHERE 1=2 " 

SearchEntity = PrimarySelectClause & WhereClause 
Exit Function 
End If 

If (EntitylD = ER.EntitylD) Then 

Set SearchColumns - gData.Applicationlnfo.GetSearchColumns (ER.EntitylD, False) 
Else 

Set SearchColumns = gData.Applicationlnfo.GetSearchColumns (v.RelationID, True) 
End If 

For Each fDef In rs. Fields 
IgnoreColumn = False 

If SearchColumns Is Nothing And (EntitylD = ER.EntitylD) Then 

SearchType = "BEGINS" 
Else 

On Error Resume Next 

EC SearchColumns (fOef .Name) 

If Err. Number = 0 Then 

SearchType = EC. SearchType 
Else 

IgnoreColumn = True 
Err. Clear 
End If 
End If 

If Not IgnoreColumn Then 

Select Case GetGenericDatatype (fDef .Type) 
Case GenericText 

If WhereClause <> "" Then WhereClause = WhereClause & " OR " 

If SearchType = "BEGINS" Then 

WhereClause = WhereClause & Lef t FieldDelimiter & fDef .Name & RightFieldDelimiter & " Like " & 
FixSQLValue (ER.EntitylD, SearchValue, Null, GenericText, oeBEGINS) 
Elself SearchType = "INCLUDES" Then 

WhereClause = WhereClause & Left FieldDelimiter & fDef .Name & RightFieldDelimiter & " Like " & 
FixSQLValue (ER.EntitylD, SearchValue, Null, GenericText, oelNCLUDES) 
Elself SearchType = "NAME_SEARCH" Then 
ParseName SearchValue, Names ( ) 
s = "" 

For j = 0 To UBound (Names) 

If s <> "" Then s = s & " And " 

s = s & LeftFieldDelimiter & fDef. Name & RightFieldDelimiter & " Like " & 
FixSQLValue (ER.EntitylD, Names(j), Null, GenericText, oelNCLUDES) 
Next j 

If s <> "" Then 
s="("&s&")" 
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WhereClause = WhereClause & s 
End If 
Else 

WhereClause = WhereClause & Lef tFieldDelimiter & fDef.Name & RightFieldDelimiter & 
FixSQLValue (ER.EntitylD, SearchValue, Null, GenericText, oeEQ) 
End If 
Case GenericDate 

If IsDate (SearchValue) Then 

If WhereClause <> "" Then WhereClause = WhereClause & " OR " 

WhereClause = WhereClause & Lef tFieldDelimiter & fDef.Name & RightFieldDelimiter & 
FixSQLValue (ER. EntitylD, SearchValue, Null, GenericDate, oeEQ) 
End If 
Case GenericNumber 

If IsNumeric (SearchValue) Then 

If WhereClause <> Then WhereClause = WhereClause & " OR " 

WhereClause = WhereClause & LeftFieldDelimiter & fDef.Name & RightFieldDelimiter & 
FixSQLValue (ER.EntitylD, SearchValue, Null, GenericNumber, oeEQ) 
End If 
End Select 
End If 
Next fDef 
End If 

If WhereClause = Then 

ER.Tag = 

SQL = 
Else 

WhereClause = "WHERE " & WhereClause & " " 
SQL = SelectClause & WhereClause 
End If 

If ER.EntitylD = EntitylD Then 

PrimaryWhereClause = WhereClause 
End If 

ER.Tag = SQL 
ERD(i) = ER 
Next i 

SQL = 

WhereClause = 
For i = 1 To UBound(ERD) 
ER = ERD(i) 

If Not GetAppInfot ER.EntitylD, "ENTITY", "REFERENCE") Then 
If (PrimaryTable <> ER.TableName) And (ER.Tag <> "") Then 

If BuildSQL (EntitylD, PrimaryTable, ER.TableName, ER.Tag) Then 

If WhereClause <> "** Then WhereClause = WhereClause & " AND " 
WhereClause = WhereClause & PrimaryKeyField & " IN (" & ER.Tag & ")" 
End If 
End If 
End If 
Next i 

If WhereClause = Then 

WhereClause = PrimaryWhereClause 
Else 

If PrimaryWhereClause =» "" Then 

WhereClause = " WHERE " & WhereClause & " " 
Else 

WhereClause = PrimaryWhereClause & " OR " & WhereClause & " " 
End If 
End If 

SQL = PrimarySelectClause & WhereClause & Prima ryOrderByClause 
SearchEntity = SQL 
End Function 
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Advanced Searching 



Private Function SQL() As String 
Dim RUtils As clsReportUtils 
Dim SelectClause As String 
Dim WhereClause As String 
Dim OrderByClause As String 
Dim FromClause As String 
Dim PrimarySelectClause As String 
Dim PrimaryWhereClause As String 
Dim PrimaryKeyField As String 
Dim PrimaryTable As String 
Dim RecordSource As String 
Dim PrimaryRecordSource As String 
Dim KeyField As String 
Dim TempWhereClause As String 
Dim ER As ENTITY_RELATION_T 
Dim i As Long 
Dim DatasourcelD As Long 

WhereClause = 
FromClause = 

DatasourcelD = GetAppInfo (m_EntityID, "ENTITY", "DATASOURCE_ID" } 
For i - 1 To UBound(m_ERD) 
ER = m_ERD(i) 

If Not GetAppInfo(ER.EntityID, "ENTITY", "REFERENCE") Then 

RecordSource = GetAppInfo (ER. EntitylD, "ENTITY", "RECORD_SOURCE" ) 
If ER.EntitylD « m_EntityID Then 

PrimaryRecordSource = RecordSource 

KeyField - GetAppInfo (ER. EntitylD, "ENTITY", "UNIQUE_FIELD_N7\ME" ) & "" 
PrimaryTable = ER.TableName 

PrimarySelectClause = "SELECT " & RecordSource & "." & KeyField & " FROM " 
If WhereClause <> "" Then WhereClause = " AND " & WhereClause 

WhereClause = RecordSource & "." & KeyField & "=" & PrimaryTable & & KeyField & WhereClause 

OrderByClause = gData . Applicationlnfo . GetEntityOrderBylER. EntitylD) 
If OrderByClause <> "" Then 

OrderByClause = " ORDER BY " & OrderByClause 
End If 

SelectClause = PrimarySelectClause 
Else 

Set RUtils = m_SearchTree("ENTITY_" & ER.EntitylD) 

If Not (RUtils-FilterCriteriaRS.BOF And RUtils. FilterCriteriaRS .EOF) Then 
ER.Tag = "CRITERIA DEFINED" 

If FromClause <> "" Then FromClause = FromClause & "," 
FromClause = FromClause & ER.TableName & & RecordSource 

End If 
End If 

m_ERD(i) = ER 
End If 
Next i 

For i = 1 To UBound (m_ERD) 
ER = m_ERD(i) 

If Not GetAppInfo (ER.EntitylD, "ENTITY", "REFERENCE") Then 
If (PrimaryTable <> ER.TableName) And (ER.Tag <> "") Then 

If BuildSQL(m_EntityID, "", PrimaryTable, ER.TableName, WhereClause) Then 

End If 
End If 
End If 
Next i 

PrimarySelectClause = PrimarySelectClause & BuildFromClause (WhereClause, GetTablePrefix (GetAppInfo (m_EntityID, 
"ENTITY" , "DATASOURCE^ID" ) ) ) 
If m_Filter <> "" Then 

WhereClause = " WHERE " & WhereClause & " AND " & m_Filter & " AND " & TraverseTree ( 1st Filters, 
IstFilters.Nodes(l) .Child) 

Else 

WhereClause = " WHERE " & WhereClause & " 7WD " & TraverseTree (IstFilters, IstFilters .Nodes ( 1 ) .Child) 

End If 

SQL = "SELECT " & PrimaryRecordSource & FROM " & GetTablePrefix { DatasourcelD) & PrimaryRecordSource & " 

WHERE " & PrimaryRecordSource & & KeyField _ 

& " IN (" & PrimarySelectClause & WhereClause & ")" & OrderByClause 



End Function 
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Child Entities 

Public Sub Refresh () 

Static CurrentEntitylD As Long 
Dim Currentltem As Long 

grdData .LoadStructureOnly = False 

grdData .CustomSQL « False 

If CurrentEntitylD = in_ParentEntityID Then 

If IstChildren.Listltems. Count = 0 Then 
Currentltem = -1 

Else 

Currentltem = IstChildren.Selectedltem.Tag 
End If 
Else 

CurrentEntitylD = m_ParentEntityID 
LoadSourceList m_ParentEntityID 
Currentltem = -1 
End If 

If IstChildren.Listltems. Count = 0 Then 
grdData . ClearList 
Currentltem = -1 
grdData. Enabled = False 

IstChildren.BackColor = UserControl .BackColor 

Elself m_ParentEntityID = -1 Then 

Set IstChildren.Selectedltem = IstChildren- Findl tern (Currentltem, IvwTag) 

grdData. Enabled = False 
Else 

If Currentltem = -1 Then 

Set IstChildren.Selectedltem = IstChildren.Listltems (1) 
Else 

Set IstChildren.Selectedltem = IstChildren. FindItem(CurrentItem, IvwTag) 
End If 

lstChildren_ItemClick IstChildren. Selectedltem 
IstChildren. ForeColor = vbBlue 
IstChildren.BackColor = vbWhite 
grdData. Enabled « True 
End If 
End Sub 

Private Sub LoadSourceList (EntxtylD As Long) 

LoadEntityChildren EntitylD, IstChildren, m_ShowAll Children 

ResizeListBox IstChildren 

UserControl_Resize 
End Sub 

Public Sub LoadEntityChildren (ParentEntitylD As Long, IstChildren As Object, ShowAllChildren As Boolean) 
Dim c As Collection 
Dim V As Variant 
Dim Item As Object 
Dim i As Long 

If TypeName( IstChildren) = "ListView" Then 
IstChildren.Listltems .Clear 

Set c « AppInformation.GetEntityChildrent ParentEntitylD) 
For Each v In c 

If (Not ShowAllChildren And Not v. DisplayOnTab) Or (ShowAllChildren) Then 
If v.EntityType = "MANY_TO_MANY" Then 

i = AppInformation.GetMapsToEntityID( ParentEntitylD, v.EntitylD) 

Set Item = IstChildren. Listltems. Add ( , , AppInformation.GetAppInfoValue (i, "ENTITY", 
"ENTITY_CAPTION" ) ) 
Else 

Set Item = IstChildren. Listltems. Add ( , , v. EntityCaption) 

End If 

Item, Tag = v.EntitylD 
If V. Required Then 

Item. ForeColor = vbRed 
End If 
End If 
Next V 

Set c = Nothing 

Elself TypeName (IstChildren) = "ListBox" Or TypeName (IstChildren) = "ComboBox" Then 
IstChildren. Clear 

Set c = Applnformation. GetEntityChildren ( ParentEntitylD) 
For Each v In c 

If (Not ShowAllChildren And Not v. DisplayOnTab) Or (ShowAllChildren) Then 
IstChildren. Addltem v. EntityCaption 
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IstChilclren.ItemData(lstChildren.Nevrlndex) «= v.EntitylD 
End If 
Next V 

Set c = Nothing 
End If 
End Sub 

Private Sub lstChildren_ItemCliclc ( ByVal Item As MSComctlLib. Listltem) 

If (IstChildren.Listltems. Count - 0) Or (IstChildren.Selectedltem Is Nothing) Then 

Exit Sub 
End If 

UserControl. Enabled = False 
m_ChildEntityID = Item. Tag 
LoadRelatedEntity m_ChildEntityID 
grdData.RowID = -1 
grdData . Refresh 
UserControl . Enabled = True 
On Error Resume Next 
IstChildren. SetFocus 
Err .Clear 
End Sub 

Private Sub LoadRelatedEntity (ChildEntitylD As Long) 

m_Context = gData.ApplicationInfo.GetRelationshipInfo(m_ParentEntityID, m_ChildEntityID, "RELATION_TYPE" ) 

grdData . Filtered » False 

grdData. Pa rent RowID = m_ParentRowID 

grdData . ParentEntitylD = m_ParentEntityID 

grdData. EntitylD = m_ChildEntityID 

grdData .Context = m_Context 

grdData.CustomSQL = False 

Select Case m_Context 

Case "ONE_TO_MANY", "^4ANY_T0_MANY" 

grdData. Filter «= Get/^plnfo (m_ChildEntityID, "ENTITY", "TABLE_NAME" ) 

gData.ApplicationInfo.GetRelationshipInfo(m_ParentEntityID, m_ChildEntityID, "RELATE D_FIELD_NAME " ) 
" & m_ParentRowID 

Case "MANY_TO_ONE" 

grdData. Filter = GetAppInfo (m_ParentEntityID, "ENTITY", "TABLE_NAME" ) &"."&_ 

GetAppInfo(m_ParentEntityID, "ENTITY", "UNIQUE_FIELD_NAME" ) & " = " & m_ParentRowID 
End Select 
End Sub 

( From D: \UserInterf ace\AppInf o\clsAppInf o . els ) 

Public Function GetEntityChildren( ParentEntitylD As Long) As Collection 
Dim c As Collection 
Dim ED As ENTITY_DATA_T 
Dim i As Long 

Set c = New Collection 
With m_rsEntityRelationship 

.Filter = "VISIBLE^TRUE AND RE FERENCE= FALSE AND ENTITY_ID=" & ParentEntitylD 

On Error Resume Next 

•Sort = "RELATIVE_ORDER ASC" 

Err. Clear 

Do While Not .EOF 

ED. EntitylD = ! RELATE D_ENT I TY_ID 

ED.RelationID = !RELATION_ID 

ED.EntityCaption = Trim$ ( ! ENTITY_CAPTION) 

ED.EntityType = ! RELATION_TYPE 

ED. Required = 'Required 

ED.DisplayOnTab = ! DISPLAY_ON_TAB 

c.Add ED, "ENTITY^" & ED. EntitylD 

.MoveNext 
Loop 

.Filter = adFilterNone 
.Move First 
End With 

Set GetEntityChildren = c 
Set c = Nothing 
End Function 
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Menus and Menu Contexts 



Public Sub Refresh 0 
Dim V As Variant 
Dim CR As CC)h4MAND_T 
Dim i As Long 

m_LoadingControl = True 

AllowDataEntry = False 

LockWindovr CurrentGrid ( ) . hvmd. True 

If m_ParentEntityID = -1 Then 
m_RelationID = -1 

If GetAppInfo(m_EntityID, "ENTITY", "REFERENCE") Then 

m_Context = "REFERENCE" 
Else 

m^Context = "ENTITY" 
End If 
Else 

m__RelationID = gData. Applicationlnfo . GetRelationshipInf o (m_ParentEntityID, m_EntityID, "RELATION_ID" ) 
m_Context = gData .Applicationlnfo. GetRelationshipInf© (m_ParentEntityID, m_EntityID, "RELATION_TYPE" ) 
End If 

If m_ObjectID = -1 Then m_ObjectID = MessageHandler.GetNextObjectID( ) 
If m_RelationID = -1 Then 

V = GetAppInfo(m_EntityID, "ENTITY_ATTRIBUTE", "ALLOW__GROUP_BY" ) 
Else 

V = GetAppInfo(m_RelationID, "RELATIONSHIP_ATTRIBUTE", "ALLOW_GROUP_BY" ) 
End If 

If IsNull(v) Then v = 0 

CurrentGrid ( ) .GroupByBoxVisible = CBool(v) 

Set m_SearchColumns = Nothing 
Select Case m_Context 
Case "ENTITY" 

Set m^SearchColumns = GetSearchColumns (m_EntityID, False) 
Case "REFERENCE" 
Case Else 

Set m_SearchColumns = GetSearchColumns (m_RelationID, True) 

End Select 

m_KeyField = GetAppInf o {m_EntityID, "ENTITY", "UNIQUE_FIELD_NAME" ) 
m_ShowKeyField = GetAppInfo (m_EntityID^ "ENTITY", "SHOW_UNIQUE_FIELD" ) 

Select Case m_Context 
Case "MANY__TO_MANY" 

m_MapsToKeyField = GetAppInfo (gData . Applicationlnfo. GetMapsToEntityID(m_ParentEntityID, m_EntityID) , 
"ENTITY" , "UNIQUE_FIELD_NAME" ) 
Case Else 

m_MapsToKey Field = 
End Select 

Select Case m__Context 

Case "ENTITY", "REFERENCE" 

m_FilterField = m_KeyField 

m_ShowFilterField = m_ShowKeyField 
Case Else 

m_FilterField = GetAppInfo (m_ParentEntityID, "ENTITY", "UNIQUE_FIELD_NAME" ) & "" 
m_ShowFi Iter Field = False 
End Select 

LockWindow CurrentGrid (). hvmd. False 
LoadGrid 

LockWindow CurrentGrid (). hwnd, True 

If Not CurrentGrid 0 .Visible Then CurrentGrid () .Visible = True 

m^RowID = -1 

SetCurrentRow 

EnableMenus 

m_Sort Column = "" 

LockWindow CurrentGrid (). hwnd. False 
m_LoadingControl = False 
End Sub 

Private Sub EnableMenus { ) 
On Error Resume Next 
Select Case CurrentGrid () .Name 
Case "IstData" 'List View 

m_DefaultMenuItem = LoadMenuItems (m_Context, "LIST", mnuOptionsDetail, VltemArray) 
Case "grdData" 'Grid View 

m_DefaultMenuItem s= LoadMenuItems (m_Context, "GRID", mnuOptionsDetail, VltemArray) 



End Select 
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Select Case m_Context 

Case "ENTITY", "REFERENCE" 

DisableMenuOptions m_EntityID, gData .GroupID 
Case Else 

DisableMenuOptions m__RelationID, gData. GroupID 
End Select 
Err. Clear 
End Sub 
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Data Entry Forms 

Option Explicit 

Private m_Cancel As Boolean 

Private m_DataEntryControl As Object 

Private m_FormLoaded As Boolean 

Public Message As MessageClass 

Private WithEvents Operation As clsOperation 

Private m_Def aultMenuItem As Long 

Private VltemArray As Variant 

Private m_Operations As Collection 

Public CallUpdateRecordOperation As Boolean 

Private m_Script As ScriptControl 

Private m_TableName As String 

Private m_EntityID As Long 

Private m_AppEnvironment As CAppEnvironment 
Private m_CancelLoad As Boolean 
Private Sub cmdCancel_Click ( ) 

Message. MessageType = MTCancel 

m_Cancel = True 

DoUnload 
End Sub 

Private Sub cmdOK_Click ( ) 
Dim ChildID As Long 
Dim i As Long 
Dim Msg As String 
Dim Cancel As Integer 

If Message. MessageType <> MTViewRecord Then 

RaiseEventEx "Bef ©revalidate" , m_TableName, Cancel 
If Cancel Then Exit Sub 

If Not m^DataEntryControl.ValidData ( ) Then Exit Sub 
RaiseEventEx "Af terValidate" , m_TableName, Cancel 
If Cancel Then Exit Sub 
SaveEntity Cancel 
If Cancel Then Exit Sub 
End If 

If Message. Context = "ENTITY" Then 

If Message .MessageType <> MTViewRecord Then 

ChildID = RequiredChildren (Message. EntitylD, CLng (Message. RowIDAr ray ( 0) ) ) 
If ChildID <> -1 Then 

For i = 1 To tabView. Tabs .Count 
Select Case tabView. Tabs ( i ). Key 
Case "General", "Relatedlnfo" 
Case Else 

If CLng (Right$ ( tabView. Tabs (i) .Key, Len (tabView. Tabs (i ) .Key) - 1)) = ChildID Then 

Msg = "Not all recommended data entry has been completed. Would you like to complete the 
recommended data entry now?" 

If MsgBox(Msg, vbYesNo + vbQuestion, Me. Caption) = vbYes Then 
tabView.TabsCi) .Selected = True 
Exit Sub 
End If 
End If 
End Select 
Next i 
End If 
End If 
End If 

m_Cancel = False 
DoUnload 
End Sub 

Private Sub Form_Activate ( ) 
On Error Resume Next 
m_DataEntryControl . SetFocus 
Err. Clear 

If m_CancelLoad Then cmdCancel_Click 
End Sub 

Private Sub SetEntityObj ect () 
Dim LocalEntitylD As Long 
Dim Local RowID As Long 
Dim ParentKeyField As String 
Dim ControlName As String 



Select Case Message. Context 
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Case "MANy_T0_M7WY" 

LocalEntitylD = gData . Applicationlnfo . GetMapsToEntityID(Message . ParentEntitylD, Message . EntitylD) 
LocalRowID GetMapsToRowID{LocalEntityID, Message. EntitylD, CLng (Mess age. RowIDAr ray ( 0) ) ) 
Case Else 

LocalEntitylD = Message. EntitylD 
LocalRowID = Message.RowIDArray ( 0) 
End Select 

m_EntityID = LocalEntitylD 

m^TableName = GetAppInfo (LocalEntitylD, "ENTITY", "TABLE_NAME" ) & 
ControlName = GetAppInfo (LocalEntitylD, "ENTITY_ATTRIBUTE", "USERCONTROL" ) & 
If ControlName = Then 

Set Tn_DataEntryControl = Controls .Add ( "AppSwift- DataEntryControl", "DEControl") 

m_DataEntryControl .Context = Message. Context 
Else 

On Error Resume Next 

Set m_DataEntryControl « Controls .Add (gData . Da taEntryControl & "." & ControlName, "DEControl") 
If Err. Number <> 0 Then 
Err .Clear 

Set m_Da taEntryControl = Controls. Add ( "AppSwift. DataEntryControl", "DEControl") 

m_Da taEntryControl .Context = Message. Context 
. End If 
End If 

m_DataEntryControl .EntitylD = LocalEntitylD 

m_DataEntryControl . SetAppInformationObj ect gData .Applicationlnfo 
On Error Resume Next 

Set m_DataEntryControl.MessageHandler = MessageHandler 
Err .Clear 

On Error GoTo ErrSetEntityObj ect 
LoadEntityTabs LocalEntitylD, tabView 

If Message. MessageType = MTDuplicateRecord Then 

in_DataEntryControl . NewRecord = True 
Elself Message. MessageType « MTNewRecord Then 

m_DataEntryControl. NewRecord = True 
Elself Message. MessageType = MTViewRecord Then 

m__DataEntryControl . Readonly = True 

m_DataEntryControl. NewRecord = False 

cmdOK. Caption "SClose" 

cmdCancel. Visible = False 

tbarOptions. Enabled = True 
Elself Message. MessageType = MTEditRecord Then 

m_Da taEntryControl. NewRecord = False 
End If 

Set m_DataEntryControl.rsData = Message. Cur rentRS 

If TypeName(m_DataEntryControl) = "DataEntryControl" And (Message. Context = "ONE_TO_MANY" Or Message. Context = 
"MANY_TO_ONE" ) Then 

On Error Resume Next 

ParentKeyField = GetAppInfo (Message. ParentEntitylD, "ENTITY", "UNIQUE_FIELD_NAME" ) 
m_DataEntryControl. ParentEntitylD « Message. ParentEntitylD 
m_DataEntryControl . SetParentID ParentKeyField, Message. ParentRowID 
Err. Clear 
End If 

m__DataEntryControl . Refresh 

Me. Caption = GetAppInfo (LocalEntitylD, "ENTITY", "ENTITY_CAPTXON" ) & " Input" 
Select Case Message. MessageType 
Case MTViewRecord 

Case MTDuplicateRecord, MTNewRecord 

m_DataEntryControl.SetCurrentID "New Record" 

If (Message. Context = "ONE_TO_MANY" Or Message. Context = "MANY_TO_ONE" ) Then 
On Error Resume Next 

ParentKeyField = GetAppInfo (Message. ParentEntitylD, "ENTITY", "UNIQUE_FIELD_NAME" ) 
m_DataEntryControl. Set Parent ID ParentKeyField, Message, ParentRowID 
Err. Clear 
End If 
Case MTEditRecord 

If (Message. Context = "0NE_T0_M7mY" Or Message. Context "MANy_TO_ONE" ) Then 
On Error Resume Next 

ParentKeyField = GetAppInfo (Message. ParentEntitylD, "ENTITY", "UNIQUE_FIELD_NAME" ) 
m_DataEntryControl. SetParentID ParentKeyField, Message. ParentRowID 
Err. Clear 
End If 
End Select 

ERelations.ShowAllChildren = False 
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ERelations . ParentEntitylD = LocalEntitylD 
ERelations . ParentRowID - LocalRowID 
ERelations .Refresh 
If ERelations. ListCount > 0 Then 

tabView. Tabs. Add , "Relatedlnfo", "&Related Info" 
End If 
Exit Sub 
ErrSetEntityObj ect : 

HandleError Err 

Err. Clear 
End Sub 

Private Sub SetFormSize ( ) 
Dim BorderHeight As Single 
Dim BorderWidth As Single 
Dim MinimumHeight As Single 
Dim MinimumWidth As Single 
Dim DEControlHeight As Long 
Dim DEControlWidth As Long 

If Me.WindowState = vbMinimized Or Me .WindowState = vbMaximized Then Exit Sub 
On Error Resume Next 

BorderHeight = Me. Height - Me. ScaleHeight + 75 

BorderWidth = Me. Width - Me.ScaleWldth + 75 

If TypeName(m_DataEntryControl) = "DataEntryControl" Then 

m_DataEntryControl.GetCardSize DEControlHeight, DEControlWidth 

m_DataEntryControl . Height = DEControlHeight 

m_DataEntryControl. Width DEControlWidth 
End If 

ERelations .Height = m_DataEntryControl .Height 
ERelations. Width = m_DataEntryControl .Width 

tabView. Width = ERelations .Width + 300 

tabView. Height = ERelations .Top + ERelations. Height - tabVievr.Top + 150 
ERelations. Left = tabView. Left + 150 
m_DataEntryControl.Left = ERelations. Left 
m_DataEntryControl.Top = ERelations. Top 

cmdCancel.Top = cmdOK-Top + cmdOK. Height + 75 
cmdOK.Left = tabView.Left + tabView. Width + 75 
crodCancel .Left = cmdOK.Left 

MinimumHeight = tabView. Top + tabView. Height + 150 
MinimumWidth = cmdOK.Left + cradOK. Width + BorderWidth + 150 
Me. Width = cmdOK.Left + cmdOK. Width + 150 
Me. Height = tabView. Top + tabView. Height + BorderHeight 
If Me. Height < MinimumHeight Then Me. Height = MinimumHeight 
CenterForm Me 
Err. Clear 
End Sub 

Private Sub Form_Initialize ( ) 

Set Operation ~ New clsOperation 

CallUpdateRecordOperation = False 

Set m_Script = New ScriptControl 

m_Script. Language = "VBScript" 

m_CancelLoad = False 
End Sub 

Private Sub Form_KeyDown (KeyCode As Integer, Shift As Integer) 
On Error Resume Next 

If (KeyCode = vbKeyM) And (Shift = vbAltMask) Then 
Select Case tabView. Selectedltem. Key 
Case "General" 
Case "Relatedlnfo" 

ERelations . ShowMenu 
Case Else 

IstChi Id. ShowMenu 
End Select 
End If 
Err. Clear 
End Sub 

Private Sub Form_Paint() 

Me. Line (0, ScaleTop) -(ScaleWidth, ScaleHeight), BackColor, BF 
End Sub 
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Private Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer) 
Select Case UnloadMode 
Case vbFormCode 
Case Else 

Message, MessageType = MTCancel 
m_Cancel = True 
DoUnload Cancel 
End Select 
End Sub 

Private Sub Forin__Resize ( ) 
On Error Resume Next 

If Not m_FormLoaded Then Exit Sub 

tabView. Width = ScaleWidth - cmdOK. Width - 150 
tabView. Height = ScaleHeight - tabView.Top - 75 
ERelations.Left = tabView. Left + 150 

ERelations. Height = tabView. Height - (ERelations . Top - tabView.Top) - 150 
ERelations. Width « tabView. Width - 300 

If TypeName(m_DataEntryControl) = "DataEntryControl" Then 

m_DataEntryControl .Height = ERelations -Height 

m_DataEntryControl. Width = ERelations. Width 
End If 

cmdOK.Left = tabView. Left + tabView. Width + 75 
cmdCancel.Left = cmdOK.Left 

IstChild.Move ERelations .Left, ERelations. Top, ERelations .Width, ERelations. Height 

Err .Clear 
End Sub 

Private Sub Form_Terminate ( ) 

Set m_DataEntryControl = Nothing 

Set Operation = Nothing 

Set m_Script = Nothing 

Set m_AppEnvironment = Nothing 
End Sub 

Private Sub Form_Unload (Cancel As Integer) 

On Error Resume Next 

m_DataEntryControl .UnloadControls 

Err. Clear 
End Sub 

Private Sub lstChild_ItemChanged(ItemEf fected As Long) 

IstChild. Refresh 

IstChild.RowID « ItemEf fected 
End Sub 

Private Sub lstChild_NewItem(ItemSelected As Long) 

IstChild . Refresh 

IstChild.RowID = ItemSelected 
End Sub 

Private Sub mnuEditCopy_Click( ) 

SendKeys "-^C" 
End Sub 

Private Sub mnuEditCut_Click ( ) 

SendKeys "'"X" 
End Sub 

Private Sub mnuEditPaste_Cllck ( ) 

SendKeys "'^v'* 
End Sub 

Private Sub mnuFileClose_Click ( ) 

crodOK_Click 
End Sub 

Public Sub RefreshForm( ) 
Dim Cancel As Integer 

m_FormLoaded = False 
IstChild. MultiSelect = True 
SetEntityObject 
SetFormSize 
m_FormLoaded = True 
tabView Click 
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LoadScripts 

RaiseEventEx "FormLoad" , m_TableName, Cancel 
If Cancel Then m_CancelLoad = True 
End Sub 

Private Sub mnuOptionsDetail_Click (Index As Integer) 

Set m__Operations = GetMenuItemOperations (mnuOptionsDetail (Index) .Tag) 
End Sub 

Private Sub Operation_DisplayDataEntryScreen (Message As MessageClass) 
Dim f As frmlnput 
Set f = New frmlnput 

Message. CurrentObjectID = MessageHandler.GetNextObjectID( ) 
Set f. Message = Message 
f .RefreshForm 
f.Show vbModal 
Set Message - f. Message 
Unload f- 
Set f = Nothing 
End Sub 

Private Sub Operation_DisplaySearchScreen (LoadEntitylD As Long, Message As AppUtils. MessageClass / 
MultipleSelection As Boolean) 
Dim f As frmFind 

Set f = New frmFind 

Message. CurrentObjectID = MessageHandler,GetNextObjectID{ ) 
f.EntitylD = LoadEntitylD 
f. Message = Message 
f .MultiSelect = MultipleSelection 
f .RefreshForm 
f.Show vbModal 
Unload f 
Set f = Nothing 
End Sub 

Private Sub tabView_Click ( ) 
Dim Cancel As Integer 

Select Case tabVlew. Select edit em. Key 
Case "General" 

ERelations .Visible = False 

IstChild. Visible False 

m_DataEntryControl. Visible = True 

m_DataEntryControl . ZOrder 

m_FormLoaded = False 

SetFormSize 

m^FormLoaded - True 
Case "Relatedlnfo" 

RaiseEventEx "BeforeValidate", m_TableName, Cancel 

If Cancel Then Exit Sub 

If Not m_DataEntryControl.ValidData() Then 

tabView.Tabs(l) .Selected = True 

Exit Sub 
End If 

RaiseEventEx "AfterValidate", m_TableName, Cancel 

If Cancel Then Exit Sub 

SaveEntity Cancel 

If Cancel Then Exit Sub 

ERelations. ParentEntitylD = Message. EntitylD 
ERelations. ParentRowID = Message. RowIDAr ray ( 0) 
IstChild. Visible = False 
m_DataEntryControl. Visible = False 
ERelations . Refresh 
ERelations. Visible = True 
ERelations . ZOrder 
Case Else 

RaiseEventEx "BeforeValidate", m_TableName, Cancel 
If Cancel Then Exit Sub 

If Not m_DataEntryControl.ValidData() Then 

tabView. Tabs (1) .Selected True 

Exit Sub 
End If 

RaiseEventEx "AfterValidate", m_TableName/ Cancel 

If Cancel Then Exit Sub 

SaveEntity Cancel 

If Cancel Then Exit Sub 

IstChild. ParentEntitylD = Message. EntitylD 
IstChild. ParentRowID = Message. RowIDArr ay (0) 
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IstChild.EntitylD = CLng (Right$ (tabView, Selectedltem.Key, Len ( tabView. Selectedltem. Key) - 1}) 
IstChild. Filter = GetAppInfo( IstChild. ParentEntitylD, "ENTITY", "UNIQUE_FIELD_NAME" ) &" = •»& 
IstChild. ParentRowID 

IstChild. LoadStructureOnly = False 

IstChild. Context = gData.Applicationlnfo.GetRelationshipInfo (IstChild, ParentEntitylD, IstChild.EntitylD, 
"RELATION_TYPE") 

IstChild. Refresh 

m_DataEntryControl .Visible = False 
ERelations. Visible = False 
IstChild. Visible = True 
End Select 
End Sub 

Private Sub SaveEntity (Optional Cancel As Integer = 0) 
Dim Result As Boolean 
Dim ID As Long 

RaiseEventEx "BeforeSave" , m__TableName, Cancel 
If Cancel Then 

Exit Sub 
End If 

m_DataEntryControl - Save 

ID = CLng(m_DataEntryControl.GetCurrentID() ) 

Message. Cur rentRowID = ID 

Mes sage. RowIDAr ray = Array (ID) 

If m_DataEntryControl .NewRecord Then 

Result = CallByName (Operation, "opinsert Record", VbMethod, Message) 

If Not Result Then 
Exit Sub 

End If 

Elself CallUpdateRecordOperation Then 

Result = CallByName (Operation, "opUpdateRecord", VbMethod, Message) 

If Not Result Then 
Exit Sub 

End If 
End If 

m_DataEntryControl. NewRecord = False 
RaiseEventEx "AfterSave", m_TableName 
End Sub 

Private Sub tbarOptions_ButtonClick (ByVal Button As MSComctlLib. Button) 
Select Case Button. Key 
Case "Cut" 

mnuEditCut_Clic)c 
Case "Copy" 

mnuEditCopy_Click 
Case "Paste" 

mnuEditPaste_Click 
End Select 
End Sub 

Public Property Get FormControls ( ) As Object 
On Error Resume Next 

If TypeName(m_DataEntryControl) = "DataEntryControl" Then 

Set FormControls = Me. Controls 
Else 

Set FormControls = m_DataEntryControl .Controls 
If Err. Number <> 0 Then 
Err. Clear 

Set FormControls = Me. Controls 
End If 
End If 
End Property 

Public Sub ShowDataEntryMenu(FieldName As String, ControlObjectID As Long) 
Dim i As Integer 
Dim Temp As String 
Dim ReferenceEntitylD As Long 
Dim MenuItemGroupingID As Long 

ReferenceEntitylD « GetEntityColumnlnfo (Message. EntitylD, FieldName, "REFERENCE_ENTITY__ID" ) 

m^DefaultMenuItem = LoadMenuItems ( "CONTROL_LIST", "LIST", mnuOptionsDetail, VltemArray) 

For i = 0 To mnuOptionsDetail .Count - 1 
With mnuOptionsDetail (i ) 
If .Caption = Then 

.Enabled = True 
Else 
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If .Tag = vbNullString Then 

MenuItemGroupingID = -1 

.Enabled = False 
Else 

MenuItemGroupingID = CLng(.Tag) 

.Enabled = IsValidMenuItem(ReferenceEntityID, gData .GroupID, MenuItemGroupingID, "CONTROL_LIST" ) 
End If 
End If 
End With 
Next i 

For i = 0 To mnuOptionsDetail. Count - 1 
Temp = VltemArray(i) 

ReplaceVariables ReferenceEntitylD, Temp 
If Temp <> "-" Then 

mnuOptionsDetail ( i) .Caption = Temp 
End If 
Next i 

PopupMenu mnuOptions 

ExecuteOperations Ref erenceEntitylD, Control Object ID 
Set m_Operations = Nothing 
End Sub 

Private Sub ExecuteOperations (Ref erenceEntitylD As Long, ControlObjectID As Long) 
Dim 0 As Variant 
Dim Result As Boolean 
Dim M As MessageClass 

If Not m_Operations Is Nothing Then 
Set M = New MessageClass 
With M 

.CurrentRowID = -1 

.CurrentObjectID = -1 

.OwnerObjectlD = ControlObjectID 

.Context ^ "CONTROL_LIST" 

.RowIDArray - Array ( .CurrentRowID) 

.ParentEntitylD = -1 

.ParentRowID = -1 

.EntitylD - Ref erenceEntitylD 
End With 

For Each O In m_Operations 

Result « CallByName (Operation, "op" & O.OperationText, VbMethod, M) 

If Not Result Then 
Exit For 

End If 
Next O 

If Result Then 

M.MessageType = MTRef reshList 
MessageHandler. Broadcast Forms, M 
End If 
End If 
End Sub 

Private Sub ReplaceVariables (Ref erenceEntitylD As Long, Str As String) 
Dim Pos As Integer 
Dim Variable As String * 2 
Dim Temp As String 

Pos = 1 
Do 

Pos = InStr(Pos, Str, "@") 
If Pos > 0 Then 

Variable = Mid$(Str, Pos, 2) 

Select Case Variable 

Case "@E" 'Current entity 

Temp = GetAppInfo( Ref erenceEntitylD, "ENTITY", "ENTITY_CAPTION" ) 
Str = Replace (Str, Variable, Temp) 

Case "@P" 'Parent entity 

Temp = GetAppInfo{-l, "ENTITY", "ENTITY_CAPTION" ) 
Str = Replace (Str, Variable, Temp) 

Case Else 

Str = Replace(Str, Variable, "????????") 
End Select 
Pos = Pos + 1 
End If 
Loop Until Pos = 0 



End Sub 
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Private Sub RaiseEventEx (EventName As String, TableName As String, Optional Cancel As Integer = 0) 
Dim CancelEvent As Variant 

On Error Resume Next 
Select Case EventName 
Case "AfterSave" 

m_Script.Run TableName & 
Case "AfterValidate" 

m_Script.Run TableName & 
Case "BeforeSave" 

m_Script.Run TableName & 
Case "BeforeValidate" 

m_Script.Run TableName & 
Case "FormLoad" 

m_Script.Run TableName & 
Case "FormUnload" 

m_Script.Run TableName & 
End Select 
Err .Clear 

Cancel = CancelEvent 

End Sub 

Private Sub LoadScripts { ) 
Dim c As Collection 
Dim i As Long 
Dim s As String 
Dim con As ADODB. Connection 

If TypeName (m_DataEntryControl ) <> "DataEntryControl" Then Exit Sub 

Set c = GetEntityScripts(m_EntityID) 
If c Is Nothing Then Exit Sub 
For i - 1 To c- Count 

On Error Resume Next 

m_Script.AddCode c(i) 

Err .Clear 
Next i 

Set c = Nothing 

Set m_AppEnvi ronment = New CAppEnvironment 
m_AppEnvironment . EntitylD = m_EntityID 

m_AppEnvi ronment . GridObj ect = m_DataEntryControl . GridObj ect 
Set c = GetEntityColumnScripts (m_EntityID) 
If c Is Nothing Then Exit Sub 
For i = 1 To c. Count 

On Error Resume Next 

m^Script .AddCode c{i) 

Err. Clear 
Next i 

Set c = Nothing 

Set con = New ADODB. Connection 

con. Open GetConnectionString (gData.Applicationlnfo. GetAppInfoValue (m_EntityID, "ENTITY", "DATASOURCE^ID" ) ) 
Set m_AppEnvi ronment . DBConnect ion = con 
m_AppEnvi ronment . Refresh 

m_Script.AddObject "AppEnvi ronment", m_AppEnvi ronment, True 
End Sub 

Private Sub DoUnload (Optional Cancel As Integer = 0) 
RaiseEventEx "FormUnload", m_TableName, Cancel 
If Cancel Then 

Exit Sub 
End If 
Me. Hide 

End Sub 

\ 



"_AfterSave" 

"^AfterValidate", CancelEvent 
"_BeforeSave", CancelEvent 
"_BeforeValidate", CancelEvent 
"_FormLoad", CancelEvent 
"_FormUnload", CancelEvent 
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Data Entry Controls 

Private m_EntityID As Long 

Public NewRecord As Boolean 

Public Readonly As Boolean 

Public rsData As ADODB. Recordset 

Public MessageHandler As MessageHandlerClass 

Public Context As String 

Private m_AppEnvironment As CAppEnvironment 

Private m_Script As ScriptControl 

Private m_KeyField As String 

Private m_ParentKeyField As String 

Private ni_ParentEntityID As Long 

Private m_ParentRowID As Long 

Private m_Has Parent As Boolean 

Private ra^Controls As Collection 

Private ra_Ref erencedControls As Collection 

Private m_CalculatedFields As Collection 

Private ra PreventValidation As Boolean 



Private Sub cboEdit_ButtonClick( ) 

Showlnfo grdData.Row, grdData. Columns I cboEdit. Tag) . Index, True 
End Sub 

Private Sub grdData_AfterColUpdate (ByVal Collndex As Integer) 
Dim cf As CCalculatedField 
Dim FieldName As String 
Dim vList As JSValueList 
Dim rs As ADODB. Recordset 
Dim col As JSColumn 
Dim ReferenceEntitylD As Long 
Dim RecordSource As String 
Dim DisplayColumn As Variant 

On Error Resume Next 

FieldName = m_Ref erencedControls (grdDat a. Columns (Collndex) .DataField) 
If Err. Number =. o Then 

For Each cf In m_CalculatedFields 
On Error Resume Next 

FieldName = cf.Ref erencedControls ( FieldName) 
If Err. Number ~ 0 Then 

Select Case cf .ReturnType 
Case "VALUE" 

grdData, Value (cf. Collndex) = EvalExpression (m_EntityID, grdData^ cf) 
Case "VALUE_LIST" 

Set col = grdDat a. Columns (cf. Collndex) 

ReferenceEntitylD = GetEntityColumnInfo(m_EntityID, col . DataField, •♦REFERENCE_ENTITY_ID" ) 
RecordSource = FormatSQLExpression (m_EntityID, grdData, cf) 

DisplayColumn = GetEntityColumnlnfo (m_EntityID, col. DataField, "DISPLAY_COLUMN" ) 

If IsNull (DisplayColumn) Then DisplayColumn - 1 

Set rs = GetReportRS( ReferenceEntitylD, RecordSource) 

If Not rs Is Nothing Then 

Set vList = col.ValueList 

vList .Clear 

Do While Not rs.EOF 

vList.Add rs(0). Value, rs (CLng( DisplayColumn) ) .Value & 
rs.MoveNext 

Loop 

rs. Close: Set rs = Nothing 
End If 

grdData.Value(cf .Collndex) = Null 
End Select 
End If 
Err. Clear 
Next cf 
End If 
Err. Clear 
End Sub 

Private Sub grdData_BeforeColUpdate (ByVal Row As Long, ByVal Collndex As Integer, ByVal OldValue As String, 
ByVal Cancel As GridEX20. JSRetBoolean) 
Dim Msg As String 

If Not m_PreventValidation Then 
m_PreventValidation = True 

Cancel = Not ValidValue (grdData, m_Controls, Collndex, Msg) 
If Cancel Then 

LockWindovr grdData. hwnd. False 
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MsgBox Msg, vbCritical + vbOKOnly, gData . Caption 

End If 

m_PreventValidation = False 
If Cancel Then Exit Sub 
End If 
End Sub 

Private Sub grdData_CardResize ( ByVal NewCardWidth As Long, ByVal Cancel As GridEX20. JSRetBoolean) 

picHeading. Width = NewCardWidth 
End Sub 

Private Sub grdData_ColButtonClick (ByVal Collndex As Integer) 
Dim ControlType As String 
Dim V As Variant 
Dim FDC_Type As Variant 
Dim f As Form 
Dim Result As Boolean 
Dim i As Long 

ControlType = GetEntityColumnInfo{ EntitylD, grdOata. Columns (Collndex) . Data Field, '•CONTROL_TYPE" ) 
Select Case ControlType 
Case "SmartComboControl" 

ShowFind Collndex 
Case "FileDialogControl" 

FDCType = GetEntityColumnlnfo (EntitylD, grdData. Columns (Collndex) . DataField, "FDC_TYPE") 
If IsNull(FDC_Type) Then FDC_Type = "OPEN" 
FDC_Type = UCase$ ( FDC_Type) 

v= GetEntityColumnInfo( EntitylD, grdData. Columns (Collndex) . DataField, "FDC__TITLE" ) 
If IsNull(v) Then 

V = Ilf (FDC_Type = "OPEN", "Open File", "Save File") 

End If 

dlgPath. DialogTitle = v 
dlgPath.CancelError = True 

dlgPath. Flags = cdlOFNPathMustExist Or cdlOFNFileMustExist 

v= GetEntityColumnlnfo (EntitylD, grdData. Columns (Collndex) . DataField, "FDC_FILTER" ) 
If IsNull(v) Then 

v= "All Files (*.*) |*.*|Text Files (* . txt ) | * . txt" 
End If 

dlgPath. Filter = v 
dlgPath. Filterlndex = 0 
On Error Resume Next 
If FDC_Type = "OPEN" Then 

dlgPath • ShowOpen 
Else 

dlgPath . ShowSave 
End If 

If Err. Number <> 0 Then 

Err. Clear 

Exit Sub 
End If 

grdData. Value (Collndex) = dlgPath. FileName 
Case "NotesControl" 
Set f = New frmNotes 
f. Notes = grdData. Value (Collndex) 
f. Re fresh Form 
f.Show vbModal 
If Not f. Cancel Then 

grdData. Value (Collndex) = f. Notes 
End If 
Unload f 
Set f = Nothing 
End Select 
End Sub 

Private Sub grdData_EndCustomEdit (ByVal Collndex As Integer) 
Dim ControlType As String 

ControlType = GetEntityColumnlnfo (EntitylD, grdData .Columns (Collndex) . DataField, "CONTROL_TYPE" ) 
Select Case ControlType 
Case " Combo BoxControl" 

If (grdData. Value(ColIndex) & "") <> (cboEdit -Value & ""} Then 

grdData. Value (Collndex) = cboEdit. Value 
End If 
End Select 
End Sub 

Private Sub grdData_InitCustomEdit (ByVal Collndex As Integer, ByVal EditBackColor As stdole . OLE_COLOR, ByVal 
EditForeColor As stdole. OLE_COLOR, ByVal Ed it Font As stdole. Font) 
Dim ControlType As String 



Dim AllowEdit As Boolean 
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ControlType = GetEntityColumnlnfo (EntitylD, grdData .Columns (Collndex) . DataField, "CONTROL_TYPE" ) 
AllowEdit = GetEntityColumnlnfo (EntitylD, grdData. Columns (Collndex) . DataField, "ALLOW_EDIT" ) 
Select Case ControlType 
Case " Combo BoxControl" 

Set cboEdit . ParentGrid = grdData 

cboEdit .Collndex = Collndex 

cboEdit .AllowEdit - AllowEdit 

cboEdit. Load grdData . Columns (Collndex) .ValueList 
cboEdit .Value = grdData .Value (Collndex) 
cboEdit. Tag = grdData .Columns (Collndex) . Data Field 
End Select 
End Sub 

Private Sub grdData_KeyPress (KeyAscii As Integer) 

If cboEdit. Visible Then cboEdit . PassKeyPress KeyAscii 
End Sub 

Private Sub grdData^MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single) 
Dim i As Integer 
Dim ControlType As String 
Dim r As Long 
Dim c As Integer 
Dim rd As JSRowData 

r = 1 

c = -1 

Select Case x 

Case grdData. CellLeftd, 1) To (grdData. CellLeft (1, 1) + grdData. CellWidthd, 1)) 
Case Else 
Exit Sub 
End Select 

For i = 1 To grdData .Columns .Count 
Select Case y 

Case grdData. CellTopd, i) To (grdData. CellTopd, i) + grdData. CellHeight(l, i) ) 
c = i 

Exit For / 
Case Else 
End Select 
Next i 

If c = -1 Then 

Exit Sub 
End If 

ControlType = GetEntityColumnlnfo (m_EntityID, grdData.Columns (c) . Data Field, "CONTROL_TYPE" ) & 
If ControlType = "SmartComboControl" Then 
Set rd = grdData.GetRowData(r) 

If UserControl.TextWidth ( rd. Value (c) & "") > (x - grdData. CellLef t (r, c) ) Then 

Showlnfo r, c. False 
End If 
End If 
End Sub 

Private Sub grdData_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single) 
Dim i As Integer 
Dim ControlType As String 
Dim r As Long 
Dim c As Integer 
Dim rd As JSRowData 

r = 1 
c -1 

Select Case x 

Case grdData.CellLeftd, 1) To (grdData .CellLef t (1, 1) + grdData. CellWidthd, 1)) 
Case Else 

Screen. Mouselcon = LoadPicture ( ) 

Screen. MousePointer = vbDefault 

Exit Sub 
End Select 

For i = 1 To grdData. Columns. Count 
Select Case y 

Case grdData. CellTopd, i) To (grdData .CellTopd, i) + grdData. CellHeightd, i)) 

c = i 
Exit For 
Case Else 
End Select 
Next i 

If c = -1 Then 
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Screen. Mouselcon = LoadPicture ( ) 
Screen. MousePointer = vbDefault 

Exit Sub 
End If 

ControlType = GetEntityColumnInfo(m_EntityID, grdData .Columns (c) . DataField, "CONTROL_TYPE" ) & 
If ControlType - "SmartComboControl** Then 
Set rd = grdData. GetRowData (r) 

If UserControl.TextWidth ( rd. Value (c) & > (x - grdData .CellLeft (r, c)) Then 

Screen. Mouselcon = LoadPicture (App. Path & "\Hand.cur") 
Screen. MousePointer = vbCustom 

Else 

Screen. Mouselcon = LoadPicture ("" ) 
Screen. MousePointer = vbDefault 
End If 
Else 

Screen. Mouselcon = LoadPicture ("" ) 
Screen. MousePointer = vbDefault 
End If 

End Sub 

Private Sub grdData_RowColChange (ByVal LastRow As Long, ByVal LastCol As Integer) 
Dim Cancel As Integer 

If grdData. col = 0 Then grdData. col = 1 
On Error Resume Next 

If grdData. col <> LastCol Then 'Field changed 

RaiseEventEx "LostFocus", grdData. Columns (LastCol ) .DataField, Cancel 
If Cancel Then 

grdData. col = LastCol 
Exit Sub 
End If 

RaiseEventEx "GotFocus", grdData .Columns (grdData. col ) .DataField 
End If 
Err. Clear 
End Sub 

Private Sub RaiseEventEx (EventName As String, FieldName As String, Optional Cancel As Integer = 0) 
Dim CancelEvent As Variant 
On Error Resume Next 
Select Case EventName 
Case "GotFocus" 

m_Script.Run FieldName & "_GotFocus" 
Case "LostFocus" 

m_Script.Run FieldName & "_Lost Focus", CancelEvent 
Cancel = CancelEvent 
End Select 
Err. Clear 
End Sub 

' Private Sub grdData_ShowCustomEdit (ByVal Collndex As Integer, ByVal EditLeft As Single, ByVal EditTop As Single, 
ByVal EditWidth As Single, ByVal EditHeight As Single, ByVal EditVisible As Boolean) 
Dim ControlType As String 

ControlType = GetEntityColumnlnfo (EntitylD, grdData. Columns (Collndex) . DataField, "CONTROL_TYPE" ) 

Select Case ControlType 
Case "ComboBoxControl" 
If EditVisible Then 

grdData. HideSelection = jgexHighLightNormal 

picBorder.Move grdData. Left + ScaleX(EditLef t, vbTwips, UserControl .ScaleMode) , grdData. Top + 
ScaleY (EditTop, vbTwips, UserControl. ScaleMode ) , ScaleX( EditWidth, vbTwips, UserControl . ScaleMode) , 
Seal eY (EditHeight, vbTwips, UserControl . ScaleMode) 

picBorder .Visible = True 

cboEdit . Set Focus 
Else 

grdData , SetFocus 

grdData. HideSelection = jgexHideSelection 
picBorder. Visible = False 
End If 
End Select 

End Sub 

Private Sub grdData_UnboundReadData (ByVal Rowlndex As Long, ByVal Bookmark As Variant, ByVal Values As 
GridEX20 . JSRowData ) 

Dim i As Integer 

Dim cf As CCalculatedField 

Dim vList As JSValueList 

Dim rs As ADODB. Recordset 
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Dim col As JSColumn 
Dim Ref erenceEntitylD As Long 
Dim RecordSource As String 
Dim DisplayColumn As Variant 

If rsData.BOF And rsData.EOF Then 

Exit Sub 
End If 

On Error Resume Next 

i = grdData .Columns (m_KeyField) . Index 
If Err. Number <> 0 Then 

Err. Clear 

Exit Sub 
End If 

For i = 1 To Values. ColCount 
Set col = grdData.Columns (i ) 

If NewRecord And i = grdData.Columns (m_KeyField) . Index Then 
On Error Resume Next 

If IsNull (rsData. Fields (col. DataField) .Value) Or IsEmpty(rsData. Fields (col . DataField) .Value) Then 

Values (i) = "New Record" 
Else 

Values (i) = rsData. Fields (col. DataField) .Value 
End If 
Err. Clear 
Else 

On Error Resume Next 

cf = m_CalculatedFields (col. Data Field) 
If Err. Number = 0 Then 
If cf.IsBound Then 
On Error Resume Next 

Values (i) = rsData. Fields (col . DataField) .Value 
Err. Clear 
End If 
Else 

On Error Resume Next 

Values (i) = rsData . Fields (col . DataField) .Value 
Err. Clear 
End If 
End If 
Next i 

'May not be necessary. Refer to BeforeColUpdate event. 
If m__Calcul at ed Fields Is Nothing Then Exit Sub 
For Each cf In m_Calcul a ted Fields 
Select Case cf .ReturnType 
Case "VALUE" 

If (Not Cf.IsBound) Then 

Values (cf. Col Index) = EvalExpression(m_EntityID, grdData, cf) 
End If 
Case "VALUE__LIST" 

Set col = grdData.Columns (cf. Col Index) 

Ref erenceEntitylD = GetEntityColumnlnfo (m_EntityID, col . DataField, "REFERENCE_ENTITY_ID" ) 
RecordSource = FormatSQLExpression (m__EntityID, grdData, cf) 

DisplayColumn = GetEntityColumnlnfo (m_EntityID, col . DataField, "DISPLAY_COLUMN" ) 

If IsNull (DisplayColumn) Then DisplayColumn = 1 

Set rs = GetReportRS (Ref erenceEntitylD, RecordSource) 

If Not rs Is Nothing Then 

col.EditType = jgexEditCustom 

Set vList - col.ValueList 

vList. Clear 

Do While Not rs.EOF 

vList.Add rs(0). Value, rs (CLng (DisplayColumn) ) .Value & "" 
rs .MoveNext 

Loop 

rs. Close: Set rs = Nothing 
End If 
End Select 
Next cf 
End Sub 

Private Sub grdData_UnboundUpdate (ByVal Rowlndex As Long, ByVal Bookmark As Variant, ByVal Values As 
GridEX20 . JSRowData ) 

Dim i As Integer 

Dim V As Variant 

Dim cf As CCalculatedField ^ 
Dim col As JSColumn 



For i = 1 To Values. ColCount 
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Set col = grdData .Columns (i ) 

If 1 <> grdData.Columns{m_KeyFielci) .Index Then 
If IsEmpty{Values(i) ) Then 

V = Null 
Else 

V = Values (i) & 

If Trim$(v) = Then v ^ Null 
End If 

If Not IsNull(v) Then 

Select Case UCase$ {col . Format ) 
Case "PERCENT" 

If InStrd, V, "%") > 0 Then v « Val(v) / 100 

End Select 
End If 

On Error Resume Next 

cf = m_CalculatedFields (col.DataField) 
If Err. Number = 0 Then 
If cf.IsBound Then 
On Error Resume Next 

rsData. Fields (col.DataField) .Value = v 
Err. Clear 
End If 
Else 

On Error Resume Next 

rsData . Fields (col.DataField) .Value = v 
Err. Clear 
End If 
End If 
Next i 
End Sub 



Private Sub picBorder_Resize ( ) 

cboEdit.Move -30, (picBorder.ScaleHeight - cbo Edit .Height) \ 2, picBorder . ScaleWidth + 60 
End Sub 

Private Sub picHeading_Resize () 
On Error Resume Next 
Linel.Xl = picHeading.ScaleLeft 
Linel.X2 = pi cHeading. ScaleWidth 

Linel.Yl = pi cHeading. ScaleHeight - (Linel .BorderWidth * 15) 
Linel.Y2 = pi cHeading. ScaleHeight - (Linel .BorderWidth ♦ 15) 

IblCaption.Move picHeading.ScaleLeft, (pi cHeading. ScaleHeight - IblCaption. Height ) / 2, picHeading. ScaleWidth 

picHeading. ScaleHeight (Linel . BorderWidth * 15) 
Err. Clear 
End Sub 



Private Sub UserControl_Initialize( ) 

m_Has Parent = False 

grdData.RowHeight = 315 

Set ra_Script = New ScriptControl 

m_Script . Language - "VBScript" 
End Sub 

Private Sub UserControl_KeyDown (KeyCode As Integer, Shift As Integer) 
If KeyCode = vbKeyTab Then 
If cboEdit. Visible Then 

If grdData. col = grdData. Columns .Count Then 

grdData. col = 1 
Else 

grdData. col = grdData. col + 1 
End If 
KeyCode = 0 
End If 
End If 
End Sub 

Private Sub UserControl_Resize ( ) 
Oh Error Resume Next 

grdData. Move 0, 0, ScaleWidth, ScaleHeight 
picHeading. Top = grdData. Top + 30 
picHeading. Left = grdData. Left + 30 
picHeading, Height = grdData.RowHeight - 30 
picHeading. Width = grdData. CardWidth 
Err. Clear 
End Sub 
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Public Sub OnControlClick ( DataField As String, ControlObj ectID As Long) 
On Error Resume Next 

UserControl. Parent. ShowDataEntryMenu DataField, ControlObj ectID 
Err .Clear 

End Sub 

Public Sub Refresh 0 

Dim fDef As ADODB. Field 
Dim col As JSColumn 
Dim i As Long 

Dim DuplicateRecord As Boolean 
Dim cf As CCalculatedField 
Dim c As Collection 

m_PreventValidation = True 

grdData.TabKeyBehavior = jgexColumnNavigation 

ra_KeyField ^ GetAppInfo (m_EntityID, "ENTITY", "UNIQUE_FIELD_NAME" ) 

grdData . Columns . Clear 
grdData. ItemCount = 1 

Set c = GetEntityColumns (m^EntitylD) 
For i = 1 To c. Count 
On Error Resume Next 
Set fDef = rsData. Fields (c(i)) 
If Err. Number = 0 Then 

Set col = grdData. Columns. Add (fDef .Name, jgexText, jgexEditTextBox, fDef. Name) 
col. DataField = fDef. Name 
Select Case GetGenericDatatype { fDef .Type) 
Case GenericDate 

col.SortType = j gexSortTypeDateTime 
Case GenericMemo, GenericText 

col.SortType = jgexSortTypeString 
Case GenericNumber 

col.SortType = jgexSortTypeNumeric 
End Select 
Else 

Set col = grdData.Columns.Add(c(i) , jgexText, jgexEditTextBox, c(i)) 

col. DataField = c(i) 
End If 
Err. Clear 

col.ColPosition = i 
Next i 

FormatColumns m_ParentEntityID, grdData, m_EntityID, m_Controls 

Set m__CalculatedFields = LoadCalculatedControls (m_EntityID, grdData) 
If Not m_Calculated Fields Is Nothing Then 
For Each cf In m_CalculatedFields 

For i = 1 To cf.ReferencedControls .Count 
If m_ReferencedControls Is Nothing Then 

Set m_ReferencedControls = New Collection 
End If 

On Error Resume Next 

m_ReferencedControls.Add cf . ReferencedControls (i) , cf .ReferencedControls (i ) 
Err. Clear 
Next i 
Next cf 
End If 

SetColumn Proper ties 
DoEvents 

If -NewRecord Then 

If rsData.BOF And rsData.EOF Then 

rsData.AddNevr 

DuplicateRecord = False 
Else 

DuplicateRecord = True 
End If 

grdOata.Value (grdData. Columns (m_KeyField) .Index) = "New Record" 
If m_HasParent Then 
On Error Resume Next 

grdData. Value (grdData .Columns (m_ParentKeyField) .Index) = m_ParentRowID 
rsData (m_ParentKeyField) .Value = m_ParentRowID 
Err. Clear 
End If 

If Not DuplicateRecord Then SetDef aultValues 

End If 

grdData.AllowEdit = Not Readonly 
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If Readonly Then 

grdData.BackColor = vbButtonFace 
grdData. BackColorHeader = vbButtonFace 
grdData .BackColorBkg » vbButtonFace 

End If 

•Set focus to first data entry cell. 
grdData. Row = 1: grdData. col = 2 
m_PreventValidation = False 
LoadScripts 
End Sub 

Public Sub Save ( ) 
If Nev/Record Then 

rsData (m_KeyField) .Value = NextSequenceVal (m_EntityID) 

End If 

On Error Resume Next 
LockWindow grdData . hwnd. True 
grdData . Update 

LockWindovr grdData . hwnd. False 
Err. Clear 
End Sub 

Private Sub UserControl_Paint () 
Static RightX As Single 
Static RightY As Single 

Line (RightX - 2, 2)-(RightX - 2, RightY - 2), UserControl . BackColor, BF 
Line (RightX - 1, 2)-(RightX - 1, RightY - 2), UserControl . BackColor, BF 

RightX = ScaleWidth 
RightY = ScaleHeight 

Line (0, 0) - (ScaleWidth, 0), vbButtonShadow, BF 
Line (1, 1 )- (ScaleWidth - 1, 1), vb3DHighlight, BF 

Line (0, l)-(Or ScaleHeight), vbButtonShadow, BF 

Line (1, 1)-(1, ScaleHeight), vb3DHighlight, BF 

Line (ScaleWidth - 2, 2 )- (ScaleWidth - 2, ScaleHeight - 2), vbButtonShadow, BF 

Line (ScaleWidth - 1, 2 )- (ScaleWidth - 1, ScaleHeight - 2), vb3DHighlight, BF 

Line (2, ScaleHeight - 2 )- (ScaleWidth - 2, ScaleHeight - 2), vbButtonShadow, BF 
Line (2, ScaleHeight - 1) - (ScaleWidth - 1, ScaleHeight - 1), vbSDHighlight, BF 

End Sub 

Public Function ValidDataO As Boolean 
If RequiredFi elds (grdData) Then 

ValidData « ApplyRules(m_EntityID, grdData, Ilf (NewRecord, "I", "U")) 
Else 

ValidData = False 
End If 
End Function 

Public Sub SetCurrentID(NewID As Variant) 

•Include this method to make interface consistent with custom data entry usercontrols . 
End Sub 

Public Function GetCurrentlDO As Variant 
On Error Resume Next 

GetCurrentID = rsData (m_KeyField) .Value 
If Err. Number <> 0 Then 

GetCurrentID = -1 

Err. Clear 
End If 
End Function 

Public Property Get EntltylDO As Long 

EntitylD = m_EntityID 
End Property 

Public Property Let EntitylD (ByVal rhs As Long) 

m_EntityID = rhs 
End Property 

Public Sub UnloadControls ( ) 

•Include this method to make interface consistent with custom data entry usercontrols. 
End Sub 

Public Sub SetAppInformationObject (Applnfo As Object) 
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•Include this method to make interface consistent with custom data entry usercontrols. 
End Sub 

Public Sub SetParentID( FieldName As String, ID As Long) 

m_ParentKeyField = FieldName 

m_ParentRowID = ID 

m_HasParent = True 
End Sub 

Private Function RequiredFields (GridControl As GridEX) As Boolean 
Dim i As Long 
Dim col As JSColumn 

RequiredFields = True 

For i = 1 To GridControl .Columns . Count 
Set col = GridControl .Columns { i ) 

If CBool (col.Tag) And Trim$ (GridControl .Value (i ) & "") = "" Then 
RequiredFields = False 

MsgBox col. Caption & " is a required field!", vbOKOnly + vblnformation, "Required Field Missing" 
GridControl . col = i 
GridControl . SetFocus 
Exit Function 
End If 
Next i 
End Function 

Public Property Get Controls () As Object 

Set Controls = UserControl .Controls 
End Property 

Public Sub GetCardSize (CardHelght As Long, CardWidth As Long) 
Dim i As Integer 

CardHeight = 0 

For i = 1 To grd Data .Columns. Count 

CardHeight = CardHeight + grdData .CellHeight ( 1, i) 
Next i 

CardWidth = grdData .CardWidth * 1.1 
CardHeight = grd Data. CardWidth * 1.1 
End Sub 

Private Sub UserControl_Terminate { ) 

Set m_Controls = Nothing 

Set m_ReferencedControls = Nothing 

Set m_CalculatedFields = Nothing 

Set m_Script = Nothing 

Set m_AppEnvironment = Nothing 
End Sub 

Private Sub SetDef aultValues ( ) 
Dim col As JSColumn 

For Each col In grdData. Columns 

If IsNull{rsData(col-DataField) ) And col . DataField <> m_KeyField Then 

grdData.Value (col. Index) = col . Def aultValue 
End If 
Next col 
End Sub 

Private Sub SetColumnProperties ( ) 
Dim i As Long 
Dim col As JSColumn 

For i = 1 To grdData, Columns .Count 
Set col = grdData. Columns (i) 
If col. DataField = m_KeyField Then 
col.EditType = jgexEditNone 
col. Visible = True 
col.CardCaption = True 
End If 
Next i 

End Sub 

Private Sub Showlnfo (Rowlndex As Long, Collndex As Integer, NewRecord As Boolean) 
Dim M As MessageClass 
Dim ReferenceEntitylD As Long 
Dim f As frmlnput 
Dim rs As ADODB. Recordset 
Dim ReferenceTable As Boolean 
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Dim V As Variant 

Dim ValidOperation As Boolean 

If Not NewRecord Then 
' grdData.col = Col Index 
* grd Data. Row = Rowlndex 

End If 

Set M = New MessageClass 

Ref erenceEntitylD = GetEntityColumnlnfo (m_EntityID, grdData . Columns (Collndex) . DataField, 
"REFERENCE_ENTITY_ID" ) 

ReferenceTable = GetAppInfo (Ref erenceEntitylD, "ENTITY", "REFERENCE") 
V - Ilf (ReferenceTable, "REFERENCE", "ENTITY") 
If NewRecord Then 

ValidOperation = IsValidOperation (Ref erenceEntitylD, gData .GroupID, v & "", "DataEntryNew" ) 
If Not ValidOperation Then Exit Sub 
Set rs = GetEmptyRS( Ref erenceEntitylD, True) 
Else 

ValidOperation = IsValidOperation (Ref erenceEntitylD, gData .GroupID, v & "DataEntryEdit" ) 

Set rs = GetSingleRowRS (Ref erenceEntitylD, CLng (grdData .Value (Collndex) ) , True) 
End If 

With M 

.CurrentRowID = Ilf (NewRecord, -1, grdData, Value (Collndex) ) 

.CurrentObjectID = -1 

.OwnerObjectID = -1 

.RowIDArray = Array ( .CurrentRowID) 

.ParentEntitylD = -1 

.ParentRowID = -1 

.EntitylD = Ref erenceEntitylD 

-Context = V 

If NewRecord Then 

.MessageType = MTNewRecord 
Else 

If ValidOperation Then 

.MessageType = MTEditRecord 
Else 

.MessageType = MTViewRecord 
End If 
End If 

Set -CurrentRS = rs 
End With 

Set f ~ New frralnput 
Set f. Message = M 

f .CallUpdateRecordOperation = True 

f .RefreshForm 

f.Show vbModal 

Set M = f .Message 

Unload f 

Set f « Nothing 

rs. Close: Set rs = Nothing 

If M. MessageType <> MTCancel And NewRecord Then 

LoadValueList -1, m_EntityID, grdData . Columns (Collndex) 

cboEdit.Load grdData. Columns (Collndex) .ValueList 

cboEdit. Value M. CurrentRowID 
End If 

Set M = Nothing 
End Sub 

Private Sub ShowFind (Collndex As Integer) 
Dim M As MessageClass 
Dim ReferenceEntitylD As Long 
Dim ReferenceTable As Boolean 
Dim f As frmFind 

Set M = New MessageClass 

ReferenceEntitylD = GetEntityColumnlnfo (m_EntityID, grdData. Columns (Collndex) .DataField, 
"REFERENCE_ENTITY_ID" ) 

ReferenceTable = GetAppInfo (Ref erenceEntitylD, "ENTITY", "REFERENCE") 

With M 

.CurrentRowID = -1 
.CurrentObjectID = -1 
.OwnerObjectID = -1 
.RowIDArray = Array ( .CurrentRowID) 
.ParentEntitylD = -1 
.ParentRowID = -1 
.EntitylD = ReferenceEntitylD 
If ReferenceTable Then 
.Context = "REFERENCE" 



EXHIBIT F 

Else 

.Context = "ENTITY" 
End If 

.MessageType = MTFindRecord 

End With 

Set f = New frmFind 

f.EntitylD = M.EntitylD 

f .Message = M 

Set M = Nothing 

f .MultiSelect = False 

f .RefreshForm 

f.Shovr vbModal 

Set M = f. Message 

If M. MessageType <> MTCancel Then 

grdData. Value (Collhdex) = M.SelectedRows (0) 
End If 
Unload f 
Set f = Nothing 

End Sub 

Private Function LoadColumnValue (Col Index As Integer, Value As Variant) As Variant 
Dim ReferenceEntitylD As Long 
Dim ControlType As String 
Dim rs As ADODB. Recordset 
Dim col As JSColumn 
Dim s As String 
Dim i As Long 

Set col - grdData. Columns (Col Index) 

ControlType = GetEntityColumnlnfo (EntitylD, col . DataField, "C0NTROL_TYPE" ) 
Select Case ControlType 
Case "SmartComboControl" 

ReferenceEntitylD = GetEntityColumnlnfo (EntitylD, col.DataField, "REFERENCE_ENTITY_ID" ) 

Set rs = GetSingleRowRS( ReferenceEntitylD, CLng( Value), False) 

col .MinRowsInCardView = rs. Fields. Count 

col.MaxRowsInCardView = col .MinRowsInCardView 

col. Wordwrap «= True 

s = 

For i = 0 To rs . Fields .Count - 1 
If s <> Then s = s & vbCrLf 

s = s & rs. Fields (i) .Name & ": " & rs. Fields (i) .Value & "" 
Next i 

rs. Close: Set rs = Nothing 
LoadColumnValue = s 
Case Else 

LoadColumnValue = Value 

End Select 
End Function 

Public Property Get ParentEntityID( ) As Long 

ParentEntitylD = m_ParentEntityID 
End Property 

Public Property Let ParentEntitylD (ByVal rhs As Long) 

m_ParentEntityID = rhs 
End Property 

Private Sub LoadScripts ( ) 
Dim c As Collection 
Dim i As Long 
Dim s As String 
Dim con As ADODB. Connection 

Set m_AppEnvironment = New CAppEnvironment 
m_AppEnvironment . EntitylD = m_EntityID 
m_AppEnvironment .GridObject = grdData 
Set c = GetEntityColumnScripts (m_EntityID) 
If c Is Nothing Then Exit Sub 
For i = 1 To c. Count 

On Error Resume Next 

m_Script .AddCode c(i) 

Err. Clear 
Next i 

Set c = Nothing 

Set con = New ADODB. Connection 

con. Open GetConnectionString(gData.ApplicationInfo.GetAppInfoValue (m_EntityID, "ENTITY", "DATASOURCE_ID" ) ) 
Set m_AppEnvironment.DBConnection = con 
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m_AppEnvironment . Re fresh 

in_Script .AddObject "AppEnvironment", m_AppEnvironment, True 

End Sub 

Public Property Get GridObjectO As GridEX 

Set GridObject = grdData 
End Property 
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Entity Business Rules 



Public Function ApplyRules (EntitylD As Long, ControlsCollection As Object, UpdateType As String) As Boolean 
Dim c As Collection 
Dim i As Integer 
Dim ER As ENTITY_RULE_T 
Dim Result As RuleActionType 
Dim GoToRuleNumber As Long 

ApplyRules = True 

Set c = AppInformation.GetEntityRules (EntitylD, UpdateType) 
If c Is Nothing Then 

Exit Function 
End If 

GoToRuleNumber - -1 
For i = 1 To c. Count 

If (GoToRuleNumber » -1) Or (GoToRuleNumber = i) Then 
ER = c(i) 

If ER.ActionType = "STOP" Then Exit For 

If TypeName (ControlsCollection) « "GridEX" Then 

Result = ValidRuleGrid (EntitylD, ER, ControlsCollection) 
Else 

Result = ValidRule (EntitylD, ER, ControlsCollection) 
End If 

If Result « RuleFailed Then 

ApplyRules = False 

Exit For 
Elself Result - GoToRule Then 

GoToRuleNumber = ER. ActionValue 
Else 

GoToRuleNumber = -1 
End If 
End If 
Next i 

End Function 

Private Function ValidRule (EntitylD As Long, EntityRule As ENTITY_RULE_T, ControlsCollection As Object) As 
RuleActionType 

Dim s As String 

Dim ControlName As String 

Dim FieldName As String 

Dim i As Integer 

Dim J As Integer 

Dim FieldListO As String 

Dim FieldListSize As Integer 

Dim V As Variant 

Dim rs As ADODB. Recordset 

Dim KeyField As String 

Dim DataType As GenericDatatype 

ValidRule = True 

KeyField = GetAppInfo (EntitylD, "ENTITY", "UNIQUE_FIELD_NAME" ) 

s = EntityRule. RuleValue 

i = InStr(s, "{") 
FieldListSize = -1 
Do While r > 0 

J = InStr(i + 1, s, "}") 

FieldName = Mid$(s, i+1, J-i-1) 

FieldListSize = FieldListSize + 1 

ReDim Preserve FieldList ( FieldListSize) 

FieldList ( FieldListSize) = FieldName 

i = InStrli + 1, s, "{") 
Loop 

For i = 0 To FieldListSize 
On Error Resume Next 

ControlName = GetControlName ( FieldList (i ) , ControlsCollection) 
V = ControlsCollection (ControlName) .Value 
If Err. Number <> 0 Then 

V = Null 

Err. Clear 
End If 

If FieldList (i) = KeyField Then 

If V = "New Record" Or IsNull(v) Then v = -1 
End If 
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J = InStrd, s, & FieldList(i) & "}") 

DataType = DB. GetDatatype (EntitylD, FieldList ( i ) ) 
v= DB. FixSQLValue(EntityID, Null, DataType, oeEQ) 

s = Left$(s, J - 1) & (V & & Mid$(s, J + (Len(FieldList (i) ) + 2)) 

Next i 

Select Case EntityRule . RuleType 
Case "SQL" 

Set rs = DB.GetRuleRS(EntityID, s) 
Case "STORED PROCEDURE" 

Set rs = DB.GetRuleRS(EntityID, s. True) 
End Select 

If rs Is Nothing Then 

MsgBox "Invalid business rule! Please refer to the system configuration database.", vbCritical + vbOKOnly, 
"Invalid Business Rule" 

ValidRule = RuleFailed 

Exit Function 
End If 

If Not (rs.BOF And rs.EOF) Then 
Select Case EntityRule. ActionType 
Case "FATAL" 

MsgBox EntityRule.ActionValue, vbCritical + vbOKOnly, "Fatal Error" 
ValidRule = RuleFailed 
Case "WARNING" 

If MsgBox (EntityRule. Act ionValue, vblnformation + vbYesNo, "Warning") = vbNo Then 

ValidRule = RuleFailed 
Else 

ValidRule = RulePassed 
End If 
Case "GO_TO_RULE" 

ValidRule - GoToRule 
End Select 
End If 

rs. Close: Set rs = Nothing 
End Function 



EXHIBIT F 

Entity Triggers 



Public Function ApplyTriggers (EntitylD As Long, RowID As Long, UpdateType As String) As Boolean 

ApplyTriggers - DB. ApplyTriggers (EntitylD, RowID, UpdateType) 
End Function 

Public Function ApplyTriggers (EntitylD As Long, RowID As Long, UpdateType As String) As Boolean 
Dim c As Collection 
Dim i As Integer 
Dim ER As ENTITY_RULE_T 
Dim Result As RuleActionType 

ApplyTriggers = True 

Set c = AppInformation.GetEntityRules (EntitylD, UpdateType, True) 
If c Is Nothing Then 

Exit Function 
End If 

For i = 1 To c. Count 
ER = c(i) 

Result = ApplyTrigger (EntitylD, ER, RowID) 
If Result = RuleFailed Then 
ApplyTriggers = False 
Exit For 
End If 
Next i 

End Function 

Private Function ApplyTrigger (EntitylD As Long, EntityRule As ENTITY_RULE_T, RowID As Long) As RuleActionType 
Dim s As String 
Dim FieldName As String 
Dim i As Integer 
Dim J As Integer 
Dim FieldListO As String 
Dim FieldListSize As Integer 
Dim V As Variant 
Dim rs Pa rams As ADODB. Recordset 
Dim KeyField As String 
Dim DataType As GenericDatatype 
Dim Success fulQuery As Boolean 

ApplyTrigger = RulePassed 

KeyField « Appinf ormat ion. GetAppInfoValue (EntitylD, "ENTITY", "UNIQUE_FIELD_NAME" ) 
s => EntityRule. RuleValue 

i = InStr(s, "{") 
FieldListSize = -1 
Do While i > 0 

J = InStr(i + 1, s, "}") 

FieldName = Mid$(s, i+1, J-i-1) 

FieldListSize = FieldListSize + 1 

ReDim Preserve FieldList { FieldListSize) 

FieldList( FieldListSize) = FieldName 

i InStr(i + 1, s, "{") 
Loop 

If FieldListSize <> -1 Then 

Set rsParams = GetSingleRowRS (EntitylD, RowID, True) 
If rsParams Is Nothing Then 
ApplyTrigger = RuleFailed 
Exit Function 
End If 
End If 

For i = 0 To FieldListSize 
On Error Resume Next 

If IsEmpty(rsParams (FieldList (i) ) .Value) Then 

V = Null 
Else 

V = rsParams (FieldList (i) ) .Value 

End If 

If Err. Number <> 0 Then 

V = Null 
Err .Clear 

End If 
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J = InStrd, s, "{" & FieidList(i) & "}") 

DataType = DB. GetDatatype ( EntitylD, FieldList ( i ) ) 

V = DB.FixSQLValue (EntitylD, v. Null, DataType, oeEQ) 

s = Left$(s, J - 1) 4 (V & & Mid$(s, J + (Len( FieldList (i ) ) + 2)) 

Next i 

If Not rsParams Is Nothing Then 

rsParams. Close: Set rsParams = Nothing 

End If 

Successf ulQuery = False 
Select Case EntityRule . RuleType 
Case "SQL" 

Successf ulQuery = ExecuteRule (EntitylD, s. False) 
Case "STORED PROCEDURE" 

Successf ulQuery = ExecuteRule (EntitylD, s. True) 
End Select 

If SuccessfulQuery Then 

ApplyTrigger = Rule Passed 
Else 

ApplyTrigger =» RuleFailed 
End If 
End Function 

Private Function ExecuteRule (EntitylD As Long, SQL TVs String, Optional IsStoredProcedure As Boolean = False) 
Boolean 

Dim com As ADODB . Command 

Dim dDef As ADOX. Catalog 

Dim i As Long 

Dim a As Variant 

Dim s As String 

On Error Resume Next 

If IsStoredProcedure Then 

i = InStrd, SQL, " vbTextCompare ) 

If i > 0 Then 

Set dDef = New ADOX. Catalog 

Set dDef .ActiveConnection = GetConnection (GetDatasourceID( EntitylD) ) 

s = Right$(SQL, Len(SQL) - i) 

a = Split (s, -1, VbTextCompare) 

SQL = Trim${Left$(SQL, i - 1)) 

Set com = dDef . Procedures (SQL) .Command 

For i - 0 To UBound(a) 

com. Parameters (i) .Value = a(i) 
Next i 
Else 

Set com = New ADODB. Command 

Set com. ActiveConnection = GetConnection (GetDatasourceID( EntitylD) ) 
Set com = dDef . Procedures (SQL) .Command 
End If 
Else 

Set com = New ADODB . Command 

Set com. ActiveConnection = GetConnection (GetDatasourcelD (EntitylD) ) 

If com. ActiveConnection Is Nothing Then 

Set com = Nothing 

ExecuteRule = False 

Exit Function 
End If 

com.CoramandType = adCmdText 
com. Comma ndText = SQL 

com.CommandTimeout = AppInformation.GetAppInfoValue("QUERY_TIMEOUT", "SYSTEM_INFO", "ATTRIBUTE_VALUE" ) 
End If 

com. Execute 

ExecuteRule = (Err. Number = 0) 

Err .Clear 

Set com = Nothing 

Set dDef = Nothing 



End Function 



